home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue61 / Stream / uScreenSaver.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-04-11  |  6.7 KB  |  284 lines
  1. unit uScreenSaver;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   uGlobals, ExtCtrls;
  8.  
  9. type
  10.   TfrmScrn = class(TForm)
  11.     Image1: TImage;
  12.     procedure FormKeyDown(Sender: TObject; var Key: Word;
  13.       Shift: TShiftState);
  14.     procedure FormCreate(Sender: TObject);
  15.     procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X,
  16.       Y: Integer);
  17.     procedure FormActivate(Sender: TObject);
  18.     procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
  19.       Shift: TShiftState; X, Y: Integer);
  20.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  21.     procedure FormShow(Sender: TObject);
  22.     procedure FormDestroy(Sender: TObject);
  23.   private
  24.     { Private declarations }
  25.     ImageIndex : integer;
  26.     Timer : TTimer;
  27.     Mouse : TPoint;
  28.     DoneOnce : boolean;
  29.     sil : TSSFileImageLocations;
  30.     procedure StartSaver(var WinMsg : TMessage); message WM_USER+1;
  31.     procedure StopSaver(var WinMsg : TMessage); message WM_USER+2;
  32.     procedure GetPassword;
  33.     procedure Trigger(Sender : TObject; var Done : Boolean);
  34.     procedure DoTimer(Sender : TObject);
  35.   public
  36.     { Public declarations }
  37.     LoadingApp : Boolean;
  38.   end;
  39.  
  40. var
  41.   frmScrn: TfrmScrn;
  42.  
  43. implementation
  44.  
  45. uses
  46.   jpeg, Registry;
  47.  
  48. const
  49.   IgnoreCount : Integer = 0;
  50.  
  51. {$R *.DFM}
  52.  
  53. procedure CursorOff;
  54. begin
  55.   ShowCursor(False);
  56. end;
  57.  
  58. procedure CursorOn;
  59. begin
  60.   ShowCursor(True);
  61. end;
  62.  
  63. procedure TfrmScrn.StartSaver(var WinMsg : TMessage);
  64. begin
  65.   if DoneOnce then exit;
  66.   DoneOnce := True;
  67.   DoTimer(nil);
  68. end;
  69.  
  70. procedure TfrmScrn.StopSaver(var WinMsg : TMessage);
  71. begin
  72.   Timer.Enabled := False;
  73.   GetPassword;
  74. end;
  75.  
  76. procedure TfrmScrn.GetPassword;
  77. var
  78.   MyMod     : THandle;
  79.   PwdFunc   : function (Parent : THandle) : Boolean; stdcall;
  80.   SysDir    : String;
  81.   NewLen    : Integer;
  82.   MyReg     : TRegistry;
  83.   OkToClose : Boolean;
  84. begin
  85.   if (SSMode <> ssRun) then begin
  86.     Close;
  87.     Exit;
  88.   end;
  89.  
  90.   IgnoreCount := 5;
  91.   OkToClose := False;
  92.   MyReg := TRegistry.Create;
  93.   try
  94.      MyReg.RootKey := HKEY_CURRENT_USER;
  95.      if MyReg.OpenKey('Control Panel\Desktop',False) then begin
  96.        try
  97.          try
  98.            ShowCursor(True);
  99.            if MyReg.ReadInteger('ScreenSaveUsePassword') <> 0 then begin
  100.              SetLength(SysDir,MAX_PATH);
  101.              NewLen := GetSystemDirectory(PChar(SysDir),MAX_PATH);
  102.              SetLength(SysDir,NewLen);
  103.              if (Length(SysDir) > 0) and (SysDir[Length(SysDir)] <> '\') then
  104.                SysDir := SysDir+'\';
  105.              MyMod := LoadLibrary(PChar(SysDir+'PASSWORD.CPL'));
  106.              if MyMod = 0 then
  107.                OkToClose := True
  108.              else begin
  109.                PwdFunc := GetProcAddress(MyMod,'VerifyScreenSavePwd');
  110.                if PwdFunc(Handle) then
  111.                  OkToClose := True;
  112.                FreeLibrary(MyMod);
  113.              end;
  114.            end
  115.            else
  116.              OkToClose := True;
  117.          finally
  118.            ShowCursor(False);
  119.          end;
  120.        except
  121.          OkToClose := True;
  122.        end;
  123.      end
  124.      else
  125.        OkToClose := True;
  126.   finally
  127.      MyReg.Free;
  128.   end;
  129.  
  130.   if OkToClose then
  131.     Close;
  132. end;
  133.  
  134. procedure TfrmScrn.Trigger(Sender : TObject; var Done : Boolean);
  135. begin
  136.   PostMessage(Handle,WM_USER+1,0,0);
  137. end;
  138.  
  139. procedure TfrmScrn.FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  140. begin
  141.   GetPassword;
  142. end;
  143.  
  144. procedure TfrmScrn.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
  145. begin
  146.   if IgnoreCount > 0 then begin
  147.     Dec(IgnoreCount);
  148.     Exit;
  149.   end;
  150.  
  151.   if (Mouse.X = -1) and (Mouse.Y = -1) then begin
  152.     Mouse.X := X;
  153.     Mouse.Y := Y;
  154.   end
  155.   else
  156.     if (Abs(X-Mouse.X) > 2) and (Abs(Y-Mouse.Y) > 2) then begin
  157.       Mouse.X := X;
  158.       Mouse.Y := Y;
  159.       GetPassword;
  160.     end;
  161. end;
  162.  
  163. procedure TfrmScrn.FormCreate(Sender: TObject);
  164. begin
  165.   LoadingApp := True;
  166.   Timer := TTimer.Create(Self);
  167.   Timer.Enabled := False;
  168.   ImageIndex := 0;
  169.   ReadINIFile;
  170.   Timer.Interval := interval;
  171.   ImageIndex := 0;
  172.   Timer.OnTimer := DoTimer;
  173.   sil := TSSFileImageLocations.Create(nil);
  174. end;
  175.  
  176. procedure TfrmScrn.FormActivate(Sender: TObject);
  177. var
  178.   Dummy : Boolean;
  179.   fs : TFileStream;
  180.   iListLoc, iMax, iSize, i, j : integer;
  181.   Buf : array[0..19] of Char;
  182. begin
  183.   if LoadingApp then
  184.   begin
  185.     fs := TFileStream.Create( Application.ExeName, fmOpenRead or fmShareDenyWrite );
  186.     try
  187.       fs.Position := fs.Size-40;
  188.       j := fs.Read(Buf,20);
  189.       if j <> 20 then exit;
  190.       iSize := StrToIntDef(Trim(buf),0);
  191.  
  192.       j := fs.Read(Buf,20);
  193.       if j <> 20 then exit;
  194.       iListLoc := StrToIntDef(Trim(buf),0);
  195.  
  196.       fs.Position := iListLoc;
  197.       try
  198.         sil := TSSFileImageLocations(fs.ReadComponent(sil));
  199.       except
  200.          Application.Terminate;
  201.       end;
  202.       iMax := sil.Count;
  203.  
  204.       fs.Position := fs.Size-iSize-40;
  205.     finally
  206.       fs.free;
  207.     end;
  208.     LoadingApp := False;
  209.     frmScrn.Color := clBlack;
  210.     frmScrn.Top := 0;
  211.     frmScrn.Left := 0;
  212.     frmScrn.Width := Screen.Width;
  213.     frmScrn.Height := Screen.Height;
  214.     Mouse.X := -1;
  215.     Mouse.Y := -1;
  216.     Application.OnIdle := Trigger;
  217.     SetWindowPos(Handle,HWND_TOPMOST,0,0,0,0,SWP_NOSIZE + SWP_NOMOVE);
  218.     SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,@Dummy,0);
  219.     CursorOff;
  220.  
  221.     frmScrn.Visible := True;
  222.   end;
  223. end;
  224.  
  225. procedure TfrmScrn.FormMouseDown(Sender: TObject; Button: TMouseButton;
  226.                               Shift: TShiftState; X, Y: Integer);
  227. begin
  228.   GetPassword;
  229. end;
  230.  
  231. procedure TfrmScrn.FormClose(Sender: TObject; var Action: TCloseAction);
  232. var
  233.   Dummy : Boolean;
  234. begin
  235.   SystemParametersInfo(SPI_SCREENSAVERRUNNING,0,@Dummy,0);
  236.   Application.OnIdle := nil;
  237.   ReleaseCapture;
  238.   CursorOn;
  239. end;
  240.  
  241. procedure TfrmScrn.FormShow(Sender: TObject);
  242. begin
  243.    ShowWindow(Application.Handle, sw_hide);
  244.    Image1.Visible := True;
  245. end;
  246.  
  247. procedure TfrmScrn.FormDestroy(Sender: TObject);
  248. begin
  249.   sil.Free;
  250. end;
  251.  
  252. procedure TfrmScrn.DoTimer(Sender: TObject);
  253. var
  254.   fs : TFileStream;
  255.   ssi : TSSImage;
  256. begin
  257.    Timer.Enabled := False;
  258.    Application.ProcessMessages;
  259.  
  260.    if sil.Count = 0 then exit;
  261.    if ImageIndex > sil.Count-1 then
  262.       ImageIndex := 0;
  263.  
  264.    Application.ProcessMessages;
  265.    fs := TFileStream.Create( Application.ExeName, fmOpenRead or fmShareDenyWrite );
  266.    try
  267.      fs.Position := sil.Items[ImageIndex];
  268.      ssi := TSSImage(fs.ReadComponent(nil));
  269.      try
  270.        TSSImage(ssi).Execute(Image1.Picture);
  271.      finally
  272.        ssi.Free;
  273.      end;
  274.    finally
  275.      fs.free;
  276.    end;
  277.    Application.ProcessMessages;
  278.    inc(ImageIndex);
  279.    Timer.Enabled := True;
  280. end;
  281.  
  282. end.
  283.  
  284.